00100	C******* SUBRS  TAIL, FERMTA, REST, BREP, EXCH, SORT2, NOZERO,
00200	C******* JDRAW,CENTR,LINX,UNPACK,ROFF,NOIR, KSIG, ALPHA, SPACER
00300		SUBROUTINE TAIL
00400		COMMON/ALF/INP(49),RMINI,RINV,RA,RX,RJX,NONO(19)
00500		COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS
00600		DIMENSION ITAIL(16)
00700		DATA ITAIL/16,100090007,110012,120016,200120016,120019,100026,
00800		1 80030,20036, 40, 33, 30031, 50029,80025,100022,120016/
00900		CALL CENTER(RJY)
01000		Q=-1.
01100		IF(RA)Q=1.
01200		IF(IPLT)GO TO 2
01300		ITAIL(1)=10
01400	1	CALL JDRAW(ITAIL,RJX,RJY,RMINI,1.,Q)
01500		RETURN
01600	2	P=Q
01700		IF(RMINI.NE.RSTJ2)P=P*.6
01800		ITAIL(1)=16
01900		CALL FILLMS(12,ITAIL(5),RJX,RJY,ABS(P),P)
02000	C RA=-,STEM UP;  RA=+, STEM DOWN.
02100		GO TO 1
02200		END
02300	
02400		SUBROUTINE REST
02500		COMMON /STF/RSTFAC(8),RSTJ2/PLTR/IPLT,RHT,DIS
02600		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
02700		EQUIVALENCE(J5,JQ(3)),(R3,RJQ(1)),(R4,RJQ(2)),(R7,RJQ(5))
02800		1,(R6,RJQ(4)),(R8,RJQ(6)),(R5,RJQ(3)),(R10,RJQ(8)),(J4,JQ(2))
02900		DIMENSION LRST(3),IRST(47),MR(2),MF(2)
03000		DATA IRST/9,100000033,160033,160030, 30,32 ,160032 ,160031,
03100		1 31,  23,100000051,100038,32,110017,200050044, 32 ,50026,
03200		1 100038,50044,100110017,70018,50017,50015,60011, 10016,
03300		1 18,  20,10022,30023, 50023, 70022,110017,
03400		1 15,100030033, 40032, 80032,120035,150039,70014,200010037,
03500		1 30039, 50039, 70037, 70035, 50033, 30033,10035/
03600		1,LRST/1,10,33/,MR/18,8/,MF/15,40/
03700	C  LRST = BEGINNING OF EACH REST, MR=FILLER WDCNT, MF=FILL START.
03800	
03900		L=J5
04000		IF(L.GT.1)L=1
04100		IF(L)L=-1
04200	C  L>3 WHEN SEVERAL TAILS ON REST
04300		R10=RSTJ2
04400		IF(IABS(J4).LT.80)GO TO 2
04500	C NEXT FOR MINI-RESTS
04600		RSTJ2=RSTJ2*.7
04700		J4=0
04800		R4=R4+2.
04900	2	CALL CENTER(CENTR)
05000		IF(J5.EQ.-3)J5=-5
05100	C  -3 IN P5 = DOUBLE WHOLE REST.
05200		IF(J5.LE.-2)CENTR=CENTR+9.4*R10
05300	C  CENTERS WHOLE REST
05400	5	CALL JDRAW(IRST(LRST(L+2)),R3,CENTR,RSTJ2,1.,1.)
05500		IF(J5.GT.-3)GO TO 4
05600		J5=J5+1
05700		CENTR=CENTR-3.133*R10
05800		GO TO 5
05900	4	IF(IPLT.GE.0)GO TO 1
06000		IF(J5)GO TO 1
06100		L=L+1
06200		CALL FILLMS(MR(L),IRST(MF(L)),R3,CENTR,1.,1.)
06300	C  WHY GO THROUGH NOTWRT??
06400	1	IF(R8.EQ.0)RETURN
06500	C  TO PUT NUM OVER REST - MULTIPLE BARS.(R8=-1 =NO NUM. OVER WHOLE RST)
06600		R4=R4+10.6
06700	C HEIGHT ??
06800		IF(IPLT)GO TO 3
06900		R6=5.96*R6
07000	C  USE PARAM 6 TO CHANGE SIZE OF CENTERING AID LINE.
07100		IF(R6.EQ.0)R6=55.
07200		CALL LINX(R3-R6,CENTR,R3+R6+16.0*RSTJ2,CENTR)
07300	C  HORIZ. LINE FOR CENTERING ON DPY ONLY.  WILL NOT PRINT!
07400	C  NEXT IS J3 
07500	3	JQ(1)=ROFF(R3+8.*RSTJ2)
07600		R5=R8
07700		R6=1.5
07800	C  NUMBER SIZE
07900		R8=0
08000	C  ↑↑↑↑↑ ALL THIS BECAUSE OF PARAM NUMS IN MAKNUM AND NOTWRT
08100		R7=0
08200	C  FOR BDR40 FONT
08300		IF(R5.GT.0)CALL MAKNUM(R5)
08400		J5=0
08500		R7=0
08600	C  ↑↑↑↑↑ NEEDED??
08700		END
08800	
08900	C  READS DATA 
09000	C  FOR SINGLE (OR DOUBLE) BAR REPEAT SIGN
09100		SUBROUTINE BREP
09200		DIMENSION IREP(35)
09300		COMMON R2,JA,CENTR,J2,R3,RJQ(39) /STF/RSTFAC(8),RSTJ2
09400		DATA IREP/35,100000015,280043,290043, 10015, 20015, 300043,310043
09500		1,30015, 40015, 320043,100020037, 30038, 40038, 50037
09600		1,50036, 40035, 30035, 20036, 20037, 50037, 20036, 40036
09700		1,100270022,280021,290021,300022,300023,290024,280024,270023
09800		1,270022, 300022, 270023, 290023/
09900		CALL CENTER(R)
10000		CALL JDRAW(IREP,R3,R,RSTJ2,1.,1.)
10100		END
10200	
10300		SUBROUTINE FERMTA
10400		COMMON R2,JA,CENTR,J2,R3,RJQ(39)/ALF/INP(49),RMINI,RINV,NO(22)
10500		COMMON /PLTR/IPLT,RHT,DIS
10600		DIMENSION JFERM(45)
10700		DATA JFERM/24,310020003,10010010,20015,60017,110017,160015,
10800		1 190010,200003,170010,150012,120014,70014,30012,10010,
10900		1 10020003,100070007,80008,100008,110007,110006,100005,80005
11000		1 ,70006, 20,100081006, 80012,  90012,  91006, 110030002, 30008,
11100		1 70002,130008,170002, 200005, 200170002,141001,100005,130008,
11200		1 170002, 100070002, 41001, 5, 30008, 70002/
11300		IF(RINV.LT.17)GO TO 1
11400		JFERM(29)=16
11500		JFERM(35)=210005
11600		IF(RINV.NE.17)GO TO 2
11700		JFERM(29)=91006
11800		J=25
11900		GO TO 4
12000	2	JFERM(29)=16
12100	C  FOR INVERTED MORDANT
12200		J=29
12300	4	RINV=1.
12400		GO TO 3
12500	1	J=1
12600	3	CALL JDRAW(JFERM(J),R3,CENTR,RMINI,1.,RINV)
12700		IF(IPLT.GE.0)RETURN
12800		IF(J.EQ.1)GO TO 5
12900		J=35
13000		JFERM(35)=10
13100	5	CALL FILLMS(JFERM(J),JFERM(J+1),R3,CENTR,1.,RINV)
13200		END
13300	
13400	CC	SUBROUTINE EXCH(X,Y)
13500	CC	Z=X
13600	CC	X=Y
13700	CC	Y=Z
13800	CC	END
13900	CF	SUBROUTINE SORT2(RPOS,M)
14000	CF	DIMENSION RPOS(2,200)
14100	CF	L=2
14200	CF3	J=-1
14300	CF	RX=RPOS(1,L-1)
14400	CF	DO 2 K=L,M
14500	CF	IF(RPOS(1,K).GE.RX)GO TO 2
14600	CF	RX=RPOS(1,K)
14700	C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
14800	CF	J=K
14900	CF2	CONTINUE
15000	CF	IF(J)GO TO 4
15100	CF	K=L-1
15200	CF	CALL EXCH(RPOS(1,K),RPOS(1,J))
15300	CF	CALL EXCH(RPOS(2,K),RPOS(2,J))
15400	CF4	L=L+1
15500	CF	IF(L.LE.M)GO TO 3
15600	CF	END
15700	
15800	CC	SUBROUTINE NOZERO(X)
15900	CC	IF(X.EQ.0)X=1
16000	CC	END
16100	
16200		SUBROUTINE PNUM
16300		COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,RJQ(16),J3,J4,J5,J6,J7,
16400		1 J10J,IPUNC,DONT,RXX,RX,JQ(10) /STF/RSTFAC(-3/4),RSTJ2
16500		DIMENSION NUMQ(44),RNUMS(341)
16600		DATA
16700	     1 NUMQ/1,11,15,23,33,38,47,57,62,79, 89,95,108,117,125,132,138
16800	     1,150,157,164,171,177,181,187,1,192,200,212,221,234,239,246
16900	     1,250,256,261,266,  271,282,285,293,298,314,330,335/
17000	      DATA (RNUMS(K),K=1,131)/10.0,1003.107, 6.102, 6.01, 3.015,
17100	     1 104.015, 107.01,107.102, 104.107, 3.107,
17200	     1 14.0, 1105.011, 101.015, 101.107, 22.0,
17300	     1 1106.011, 102.015, 3.015, 7.011, 7.005, 107.107, 7.107, 32.0,
17400	     1 1107.015, 7.015, 101.007, 3.007, 7.003, 7.102, 3.107, 103.107,
17500	     1 107.103, 37.0, 1007.102, 107.102, 2.015, 2.107, 46.0, 1107.107,
17600	     1 4.103, 7.0, 7.004, 2.006, 107.004, 107.015, 7.015, 56.0,
17700	     1 1004.015, 107.0, 107.103, 103.107, 4.107, 7.103, 7.0, 3.003,
17800	     1 104.003, 61.0, 1107.011, 107.015, 7.015, 107.107, 78.0, 1003.004,
17900	     1 7.0, 7.103, 4.107, 104.107, 107.103, 107.0, 103.004, 3.004,
18000	     1 6.008, 6.012, 2.015, 102.015, 106.012, 106.008, 103.004,
18100	     1 88.0, 1104.107, 7.008, 7.011, 4.015, 104.015, 107.011, 107.008,
18200	     1 103.005, 4.005, 94.0, 1106.107, 0.015,6.107,1004.101,104.101,
18300	     1 107.0, 1106.107, 106.015, 3.015, 6.012, 6.007, 3.004, 1106.004,
18400	     1 2.004, 6.001, 6.104, 3.107, 106.107, 116.0, 1006.104, 3.107,
18500	     1 103.107, 106.104, 106.011, 103.015, 3.015, 6.011, 124.0,
18600	     1 1106.107, 106.015, 3.015, 6.011, 6.103, 3.107, 106.107,
18700	     1 131.0, 1006.107, 106.107, 106.015, 6.015, 1003.005, 106.005/
18800	C   THE NEXT IS FOR 'F' TO 'P'
18900	C   1 NUM NOT NEEDED IN 'G'  ALSO IN RNOTE (1/2 NOTE).
19000	      DATA (RNUMS(K),K=132,199)/
19100	     1 137.0, 1106.107, 106.015, 6.015, 1003.005, 106.005, 149.0, 
19200	     1 1001.102, 6.102, 6.104, 6.104, 3.107, 103.107, 106.104, 
19300	     1 106.011, 103.015, 3.015, 6.011, 156.0, 1106.107, 106.015,
19400	     1 1006.015, 6.107, 1006.005, 106.005, 163.0, 1106.107, 0.107,
19500	     1 1103.107, 103.015, 1106.015, 0.015,
19600	     1 170.0, 1110.102, 110.105, 108.107, 103.107, 101.105, 101.015, 
19700	     1 176.0, 1106.107, 106.015, 1006.015, 106.005, 6.107, 180.0,
19800	     1 1006.107, 106.107, 106.015, 186.0, 1106.107, 106.015, 1.004,
19900	     1 8.015, 8.107, 191.0, 1106.107, 106.015, 6.107, 6.015, 199.0
20000	     1, 1106.107, 106.015, 3.015, 6.012, 6.007, 3.004, 106.004/ 
20100	C   'Q' TO ')'
20200	      DATA(RNUMS(K),K=200,341)/
20300	     1 211.0, 1003.107, 6.102, 6.01, 3.015, 103.015, 106.01, 106.102,
20400	     1 103.107, 3.107, 1001.001, 7.108, 220.0, 1106.107, 106.015,
20500	     1 3.015, 6.012, 6.007, 3.004, 106.004, 6.107, 233.0, 1106.104,
20600	     1 103.107, 3.107, 6.104, 6.001, 3.004, 103.004, 106.007, 106.011,
20700	     1 103.015, 3.015, 6.01, 238.0, 1106.015, 7.015, 1000.015, 0.107,
20800	     1 245.0, 1106.015, 106.104, 103.107, 3.107, 6.104, 6.015, 249.0,
20900	     1 1106.015, 0.107, 6.015, 255.0, 1106.015, 103.107, 1.005, 5.107,
21000	     1 8.015, 260.0, 1106.015, 6.107, 1106.107, 6.015, 265.0, 1106.015,
21100	     1 0.003, 1106.107, 6.015, 270.0, 1106.015, 6.015, 106.107, 6.107,
21200	     1 281.0, 1105.102, 105.105,103.105,104.102,104.105,105.102,103.102,
21300	     1103.108, 106.112, 1106.112, 284., 1110.003, 2.003, 292., 1105.102,
21400	     1 105.105,104.102,104.105,103.102,103.105,105.102,297.0,1110.007,
21500	     1 2.007, 1110.0, 2.0, 313.0, 1101.015, 103.013, 105.010,
21600	     1 106.006,106.002,105.102,103.105,101.107, 103.104,104.102,105.002
21700	     1 ,105.006,104.01,103.012,101.015, 329.0,1107.015,105.013,
21800	     1 103.01 ,102.006,102.002,103.102,105.105,107.107, 105.104,104.102
21900	     1 ,103.002,103.006,104.01,105.012,107.015,  334.0,1110.003,
22000	     1 2.003, 1104.009, 104.103,  341.0,1110.004, 2.004, 1101.009,
22100	     1 107.101, 1101.101, 107.009/
22200	C  3RD ITEM IN 19400 NOT NEEDED 12/73
22300	C  1-10=NUMS 0-9, 11-36=ALPHA, 37-42=SIGNS
22400	
22500		CALL CENTX
22600		J10J=J5
22700		CALL NOZERO(R6)
22800		SIZ=R6*RSTJ2
22900		IPUNC=0
23000		IF(J10J.LT.44)GO TO 451
23100		IPUNC=J10J
23200		IF(J10J.EQ.44)J10J=38
23300		IF(J10J.GE.45)J10J=36
23400		IF(J5.NE.46)GO TO 451
23500		RXX=4
23600		CALL RJBX(-RXX)
23700		RX=16
23800		CENTR=CENTR+RX*SIZ
23900	451	IX=NUMQ(J10J+1)
24000	C  IX=END # OF ITEM
24100	C  IX+1=1ST PART OF ITEM
24200	      CALL RDRAW(IX+1,RNUMS(IX),RNUMS,SIZ,R3,CENTR+RSTJ2*3.,SIZ)
24300		IF(IPUNC.EQ.0)RETURN
24400		IF(IPUNC.NE.46)GO TO 351
24500		CALL RJBX(SIZ*2.*RXX)
24600	C  FOR "
24700	651	IPUNC=0
24800		GO TO 451
24900	351	RXX=11
25000	C FOR : AND ;
25100		CENTR=CENTR+RXX*SIZ
25200		J10J=38
25300		GO TO 651
25400		END
     

00100	C****** FOR LISTS OF LETTERS, ETC. AND TRILL *******
00200		SUBROUTINE ALPHA
00300		COMMON /PLTR/IPLT,RHT,DIS /FONT/JFONT
00400		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
00500	       EQUIVALENCE(J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),
00600		1(R8,RJQ(6)),(NRJ,RJQ(8)),(JX,JQ(11)),(RSX,JQ(12)),
00700		1(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
00800		1,(J6,JQ(4)),(R7,RJQ(5)),(R4,RJQ(2)),(IFNT,JQ(13)),(J11,JQ(9)),
00900		1(RSP,JQ(15)),(RY,JQ(16)),(RX,JQ(17)),(RZ,JQ(18)),(RW
01000		1,JQ(19)),(RB,JQ(20)),(R,RJQ(20)),(FILL,RJQ(19)),(R9,RJQ(7))
01100		1,(JTR,RJQ(17)),(RF,RJQ(15)),(JR3,RJQ(14)),(R3,RJQ(1))
01200		1,(R10,RJQ(8))
01300		COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,POS
01400		DATA R4X/-2.1/,IFNT/1/
01500	
01600		IF(JA.EQ.7)GO TO 20
01700		JTR=99
01800		IF(R5.GE.100)R5=R5-100
01900	C >100 FOR TEXT IN ORCH SCORES FOR ALL SEP. PARTS.
02000	C  PRIMITIVE IS DEFAULT FONT.  #=SET BACK TO PRIM.
02100	C ONLY 11 LETTERS WITHOUT FONT RESET.
02200		IF(NR.EQ.'PRIM0')GO TO 54
02300		IF(NR.EQ.'BDI40')GO TO 54
02400		NR='BDR40'
02500	C  THE ABOVE IN CASE FONT IS NOT ESTABLISHED.
02600	54	R=19.7*R5*RSTJ2
02700		RB=J3
02800		RW=R4
02900		J9=0
03000	C J9=0 AVOIDS ROTATION IN 'CLEFS'
03100		DO 50 KA=4,6
03200		NXZ=-1
03300		RZ=RJQ(KA)
03400	CC	JY=RZ
03500	CC	IF(JY.NE.RZ)GO TO 130
03600	CC	IF(JY.EQ.RZ)GO TO 13
03700	C  WILL LOSE ON "0AB0" IN OLD FILES**************
03800	CC	IF(JY.GT.999999)GO TO 13
03900	CC130	RZ=100.*RZ
04000	C  FOR OLD FORMAT OF CODE 16
04100	13	JY=RZ+.2
04200		JX=1000000
04300		DO 53 LA=1,4
04400		J5=JY/JX
04500		J5X=J5
04600		R3=J3
04700		IF(J5.EQ.99)GO TO 55
04800	73	IF(KFNT)IFNT=1
04900	C READS OLD SYS. AND NEW AUTOMATIC LWR CASE.
05000		IF(J5.LT.70)GO TO 72
05100		KFNT=-1
05200	C  SETS AUTOMATIC LOWER CASE FLAG.
05300		IFNT=-1
05400	C  60 ADDED FOR LOWER CASE LETTERS.
05500		J5=J5-60
05600	C NO MORE IN THIS WD.
05700	72	IF(J5.LT.50)GO TO 1
05800		GO TO(2,3,9,4,5),J5-49
05900	C SWITCHES FOR DIFF. FONTS.(55 MAKES ')48=UPR,49=LWR,50=BDR,51=BDI,52=PRM
06000	C  ********* UPPER AND LOWER NUMBERS(48,49) NO LONGER NEEDED.(SEE 73 ↑)
06100		IF(J5.GT.55)GO TO 10
06200		J5=36
06300		R4=R4+2.9
06400	C  55 WILL MAKE ' --- 56=?  57=! (THEY COME AFTER y z IN BDR46)
06500		GO TO 1
06600	10	J5=J5+6 
06700		NRX=NR
06800		NXZ=0 
06900		NR='BDR40'
07000		NJF=JFONT
07100		JFONT=-1
07200		GO TO 1
07300	2	NR='BDR40'
07400	C  &=NON-ITALICS  --  JFONT IS TEMPORARY SWITCH  5/74
07500		IF(JFONT)GO TO 9
07600		GO TO 11
07700	CC	GO TO 8
07800	3	NR='BDI40'
07900	C  @=51=ITALICS
08000		IF(JFONT)GO TO 9
08100	C  TYPE '44 -1' TO MAKE ALL FONTS INTO 'PRIM'
08200	CC8	IF(IFNT.EQ.0)IFNT=-1
08300		GO TO 11
08400	4	FILL=-2
08500		GO TO 11
08600	5	FILL=0
08700		GO TO 11
08800	9	NR='PRIM0'
08900		GO TO 11
09000	1	CALL SPACER(J5,IFNT,RB,R)
09100		IF(J5.GT.60)GO TO 71
09200	C  NOW 62=?  63=!  IN BDR46
09300		IF(J5-47)7,6,11
09400	7	IF(JFONT.NE.0)GO TO 77
09500		IF(IPLT.GE.0)GO TO 30
09600	C  JFONT=0 FOR FIXED WIDTH OF FONTS.  = AND ONLY DPYS PRIMITIVE.
09700	CC	J5=J6
09800	CC	IF(IFNT.EQ.0)GO TO 30
09900	77	IF(J5.GE.36)GO TO 30
10000	C  PUNCTUATION AND SPACE.
10100		IF(NR.NE.'PRIM0')GO TO 70
10200		IF(IFNT.GE.0)GO TO 30
10300	CC*** WAS (IFNT.EQ.1) ????  1/76
10400		IF(J5.LT.10)GO TO 30
10500	C  JUMP TO USE UPPER CASE PRIM. LOWER CASE STARTS IN PRIM1.
10600		GO TO 71
10700	70	IF(J5.LE.9)GO TO 71
10800		IF(IFNT)J5=J5+26
10900	71	RX=R6
11000		R6=R5*.28
11100	C  .29 IS SIZE FACTOR -- PERHAPS CHANGE SIZE IN FONT TO =1.
11200		RY=R7
11300		R7=R6
11400		RZ=R8
11500		R4=R4+R4X
11600	C  SHIFTS DOWN ??? WHY NOT GET RID OF THIS.??
11700		R8=FILL
11800		NRJ=NR
11900	C  GETS RIGHT FILE
12000		JA=12
12100	C  ANY NON-11 NUMBER .GT.10 WILL DO.
12200	CC	R2=J2
12300		CALL CLEFS
12400		R6=RX
12500		R7=RY
12600		R8=RZ
12700	C  PUTS BACK RIGHT STUFF
12800		IF(NXZ)GO TO 6	
12900		NR=NRX
13000		JFONT=NJF
13100		GO TO 6
13200	
13300	30	J7=0
13400		R6=R5
13500		CALL PNUM
13600	C  47=BLANK  (WAS 99)
13700	6	J3=ROFF(RB)
13800		R4=RW
13900	11	JY=JY-J5X*JX
14000	C TO GET NEXT NUM OUT OF JY
14100	53	JX=JX/100
14200	50	CONTINUE
14300	55	IF(JTR.EQ.99)GO TO 100
14400		GO TO 52
14500	
14600	
14700	C  FOR TRILLS
14800	C  7, POS1, STF, NT#, SIZE, POS2, X     IF X=1 THEN NO WAVEY LINE
14900	20	RF=R6
15000		IF(J7.LE.1)GO TO 200
15100		IF(J7.GE.8)GO TO 201
15200	C JUMP FOR OTTAVA
15300	C  NEXT FOR SPECIAL PEDAL MARKS.
15400	
15500	C PEDAL: 7,STF,POS,0=STND POS,NNN=PEDS,POS2,BRACK #S,LFT POS BRK.
15600	C P5=101 MEANS LFT & RT PEDS., P7=2 NO BRK, =3 --!, =4 ----
15700		RW=R8
15800		RB=R3
15900		NR=J7
16000		JY=J5
16100		CALL NOZERO(R9)
16200		RY=R9
16300		RX=23.84*R9*RSTJ2
16400		R6=.45*RY
16500		J9=0
16600		J5=18
16700	C  IN FILE CLEF1.DMD
16800		JA=3
16900		R5=0
17000		R7=0
17100		R4=R4-6
17200	C  STANDARD POS IS AT -6 ******  (I.E. P4=0 PUTS TOP OF IT AT -6)
17300		CALL CLEFS
17400		IF(JY.EQ.0)GO TO 222
17500		R8=-1
17600		J5=19
17700		IF(JY.LT.100)GO TO 203
17800		JY=JY-100
17900		CALL CLEFS
18000	203	R3=RB+RX
18100		IF(JY.LT.10)GO TO 204
18200		JY=JY-10
18300		CALL CLEFS
18400	204	R3=RB+RX+RX
18500		IF(JY.NE.0)CALL CLEFS
18600	C PRINTS THE 3 BOTTOM ITEMS
18700	
18800	222	IF(NR.EQ.2)RETURN
18900		IF(RW.NE.0)R3=RB-5.96*RW
19000	C  FOR BRACKET
19100		RX=POS
19200		R6=RF
19300		R4=R4+3.
19400		R5=R4
19500		J7=0
19600		R7=0
19700		R8=0
19800		R10=0
19900	206	CALL ITMSUB
20000		IF(NR.EQ.4)RETURN
20100	C  R7=4= NO END ON BRKT.
20200		POS=RX
20300	C  POS GOT RUINED IN ITMSUB.
20400		R3=ROFF(RHORZ(RF))
20500		R5=R5+1.4*RY
20600		CALL ITMSUB
20700		RETURN
20800	
20900	C  NEXT FOR 8VA BASSA
21000	202	R7=47717088.
21100		R8=88709999.
21200		RR10=138.
21300		R6=51089170.
21400		GO TO 214
21500	201	CALL NOZERO(R5)
21600		IF(J7.EQ.15)GO TO 205
21700		R6=51089170.
21800	C NEXT = 8VA
21900		RR10=47.
22000		R7=99999999.0
22100	214	RR5=R5*RSTJ2
22200		RR3=R3+RR10*RR5
22300	C  SAVE FOR POS. OF DASHES
22400		JTR=-1
22500		J4=J7
22600		J10=J8
22700	C SAVE THESE IN PARAMS NOT USED IN ALPHA
22800		GO TO 212
22900	
23000	C  15MA - - - - -
23100	205	R6=51010582.
23200		R7=70999999.
23300		RR10=56.
23400		GO TO 214
23500	
23600	C NEXT FOR THE DASHES. J8=1 =NO END BRACK.
23700	213	R8=1.8*RR5
23800		R9=0
23900		R3=RR3
24000		R6=RF
24100		R4=R4+.7*RSTJ2
24200		R5=R4
24300		J5=J4
24400		J11=-1
24500		IF(J4)J11=-J11
24600		IF(J10.NE.0)J11=0
24700		J7=1
24800		J10=0
24900	C  GO DRAW THE DASHES
25000		CALL ITMSUB
25100		RETURN
25200	
25300	200	CALL NOZERO(R5)
25400		IF(J7.EQ.-8)GO TO 202
25500		RR10=R5
25600	C  ↑↑↑↑↑ R10 GETS WIPED OUT IN ALPHA OR CLEFS.
25700		J3=J3+6*RSTJ2
25800		JR3=J3
25900		R6=51898799.0
26000	C  @tr  LWR CASE, ITAL.  TR
26100		R7=99999999.0
26200		R8=R7
26300		JTR=J7
26400	212	R5=.8*R5
26500		GO TO 54
26600	52	IF(JTR.NE.0)GO TO 100
26700	C   GO TO 100 IF NO WAVY LINE IS NEEDED
26800		R3=JR3+20.*RSTJ2*RR10
26900		JA=4
27000		J7=-2
27100	C  J7 IS SWITCH TO DRAW WIGGLE
27200		R6=RF
27300		R9=.7*RR10
27400	C  SETS WIGGLE HEIGHT
27500		R8=.9*RR10
27600	C  RR10 IS SIZE (P5)
27700		J10=0
27800		IF(IPLT)J10=1
27900		CALL ITMSUB
28000	C  SINGLE WIGGLE ON DPY, DOUBLE ON PLOTTER.
28100	100	IF(JTR)GO TO 213
28200		IF(KFNT)IFNT=1
28300		KFNT=0
28400		END
28500	
28600	
28700		SUBROUTINE SPACER(J5,IFNT,RB,R)
28800	C  SPACES ALPHABET ITEMS.
28900		DATA RS/1.08/,RSPC/1./,RLWR/.96/
29000	C  JUMP TO USE PRIMITIVE ALPHABET.
29100		IF(J5.GT.47)GO TO 10
29200		IF(J5.LE.9)GO TO 177
29300		IF(J5.LT.36)GO TO 10
29400	C NEXT FOR NUMBERS, SPACE AND PUNCTUATION.
29500	177	RSX=RSPC
29600		IF(IFNT)RSX=.9
29700		GO TO 3
29800	10	IF(J5.LT.47)GO TO 5
29900		IF(J5.EQ.52)GO TO 14
30000		IF(J5.EQ.48)IFNT=1
30100		IF(J5.EQ.49)IFNT=-1
30200	C  ABOVE 2 NO LONGER NEEDED.
30300		IF(J5.GE.55)GO TO 5
30400	C  PUNCT. WILL EXPAND ABOVE 54.
30500		RETURN
30600	14	IFNT=0
30700	C  #=52=PRIMITIVE
30800		JA=10
30900		RETURN
31000	5	RSX=RS
31100		IF(IFNT)RSX=RLWR
31200	C  FOR LOWER CASE SPACING.  (96%)
31300		IF(J5.EQ.22)GO TO 277
31400		IF(J5.NE.32)GO TO 3
31500	277	RSX=RSX*1.12
31600	C  FOR M AND W
31700	3	IF(J5.GE.36)GO TO 21
31800		IF(J5.EQ.1)GO TO 21
31900		IF(J5.EQ.18)GO TO 21
32000		IF(J5.EQ.19)GO TO 21
32100	C  FOR 1,I AND J
32200		IF(IFNT.GE.0)GO TO 4
32300	C  NEXT FOR LOWER CASE ONLY.
32400		IF(J5.EQ.15)GO TO 21
32500		IF(J5.EQ.19)GO TO 21
32600		IF(J5.EQ.21)GO TO 21
32700		IF(J5.NE.29)GO TO 4
32800	21	IF(J5.NE.47)RSX=RSX*.68
32900	C  FOR F,I,J,L,T
33000	4	RB=RB+R*RSX
33100		END
33200	
33300	
33400	CC	SUBROUTINE JDRAW(M,R3,CENTR,RSTJ2,RX,RY)
33500	CC	COMMON/LL/LL
33600	CC	DIMENSION M(1)
33700	CC	RC=RX*RSTJ2
33800	CC	RD=RY*RSTJ2
33900	CC	DO 2 K=2,M(1)
34000	CC	CALL UNPACK(IA,IB,M(K))
34100	CC2	CALL LINES(FLOAT(IA)*RC+R3,FLOAT(IB)*RD+CENTR,LL)
34200	CC	END
34300	
34400	CC	SUBROUTINE CENTER(CNTR)
34500	C  TO CENTER ITEMS CREATED WITH DRAWING PROG.
34600	CC	COMMON /STF/RSTFAC(8),RSTJ2
34700	CC	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
34800	CC	EQUIVALENCE (R4,RJQ(2))
34900	CC	CNTR=POS+(2+AMOD(R4,100.)*7)*RSTJ2
35000	CC	END
35100	
35200	CC	SUBROUTINE LINX(A,B,C,D)
35300	C  SAVES SPACE FOR SINGLE LINES.
35400	CC	CALL LINES(A,B,3)
35500	CC	CALL LINES(C,D,2)
35600	CC	END
35700	
35800	CC	SUBROUTINE UNPACK(M,N,I)
35900	CC	COMMON/LL/L
36000	C  L IS FOR VIS. OR INVIS. LINES.
36100	CC	N=I
36200	CC	L=2
36300	CC	M=N/100000000
36400	CC	IF(M.EQ.0)GO TO 2
36500	CC	L=3
36600	C  ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
36700	CF	IPOS=ROFF(RJQ(1)*DIS)
36800	CCCF	IF(RMINI.LT..9)IPOS=IPOS+1
36900	CF	JPOS=ROFF(CENTR*RHT)
37000	CF	IF(-RMINI.EQ.PRE)GO TO 10
37100	CF	PRE=-RMINI
37200	CCCF	D=.25*RMINI
37300	CF	D=.25
37400	CF	B=BH*RMINI*RHT
37500	CF	E=RMINI*DIS
37600	CF	A=BL*E
37700	CF	IC=A
37800	CF	A=A*A
37900	CF	E=-B/4.
38000	CF	K=B
38100	CF	B=B*B
38200	C  USES EQUATION FOR ELLIPSE
38300	CF	N=1
38400	CF	NX=2
38500	CF6	DO 1 J=-K,K
38600	CF	Y=J*J
38700	CF	X=SQRT(A-(A*Y)/B)
38800	CF	L=E-X
38900	CF	M=X+E
39000	C  THE TWO SIDES OF THE LINE
39100	CF	IF(N)CALL EXCH(L,M)
39200	CF	IRN(NX)=L
39300	CF	IRN(NX+1)=M
39400	C     C IS VERTICLE POS.
39500	CF	NX=NX+2
39600	CF	E=E+D
39700	C   E IS TO TILT IT.
39800	CF1	N=-N
39900	CF10	CALL PLOT(IPOS+3,JPOS,3)
40000	CF	N=2
40100	C   1ST LOC. OF ARRAY HAS "PRE"
40200	CF	L=IPOS+IC
40300	CF	DO 11 M=-K,K
40400	CF	J=M+JPOS
40500	CF	CALL PLOT(L+IRN(N),J,2)
40600	CF	CALL PLOT(L+IRN(N+1),J,2)
40700	CF11	N=N+2
40800	CF	END
40900	
41000	CC	SUBROUTINE RJBX(R)
41100	CC     COMMON Q(4),R3,RJQ(39)/STF/RSTFAC(8),RSTJ2
41200	CC	R3=R3+R*RSTJ2
41300	CC	END
41400	
41500	CC	SUBROUTINE CENTX
41600	CC     COMMON A,B,CENTR,D,E,R4,R(38) /STF/RSTFAC(8),RSTJ2
41700	CC	1 /POSI/STFF(8),JJ2,POS
41800	CC	CENTR=POS-18.*RSTJ2+AMOD(R4,100.0)*RSTJ2*7.
41900	CC	END
42000	C******** THE ABOVE ARE NOW IN SMALL.FAI (3/75)
42100	
42200	C****** 7, STF, POS, HGT, NUM OF SHARPS OR FLATS(+ OR -), CLEF
42300	C		      (	CLEF = TREB,0  BASS,1  ALT,2  TEN,3 )
42400		SUBROUTINE KSIG
42500	C   FOR KEY SIGNATURES AND ACCENTS, ETC. (IN 'SCORE')
42600	      COMMON R2,JA,CENTR,J2,RJQ(20),JQ(17),T,S,Z/STF/RSTFAC(-3/4),RSTJ2
42700		EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J6,JQ(4))
42800		1,(R6,RJQ(4))
42900	
43000		JA=9
43100	C  USES THIS KEY NUM IN NOTWRT
43200	C   COUNTER
43300		IZ=IABS(J5)
43400	C  NUMBER OF CALLS ON NOTWRT
43500	C  THE CLEF NUM.  IT GETS WIPED OUT IN NOTWRT.
43600		JW=1
43700		R6=0
43800		IF(J5.GT.0)JW=2
43900	C   THE CODE FOR FLAT OR SHARP
44000		IF(IZ.LT.100)GO TO 5333
44100		JW=3
44200		IZ=IZ-100
44300	C WILL MAKE NATURALS IF 100 IS ADDED OR SUBTRACTED.
44400	5333	CLEF=-(J6+1)
44500	C CLEF #S ARE CHNGD TO -1,-2,-3,-4 (TREB.,BA.,ALT.,TEN.)
44600	C  CLEF NOW SET IN MAIN PROG.
44700	C  IF NO CLEF GIVEN, TREBLE IS USED.
44800		T=10.
44900		IF(CLEF.LT.-2.)T=11.
45000		S=CLEF+4.
45100		IF(CLEF.EQ.-4)S=-1.
45200		IF(J5.LT.0)GO TO 253
45300		W=-3.
45400		YY=4.
45500		Z=11.
45600	C  SHARPS
45700		GO TO 353
45800	253	W=3.
45900		YY=-4.
46000		Z=7.
46100	C  FLATS
46200	353	N=1
46300		Z=Z+R4
46400		RX=JQ(1)
46500		RA=0
46600	C   RA IS AMOUNT TO BE ADDED TO ORIGINAL POS.
46700		DO 553 KA=1,IZ
46800		J5=JW
46900		RJQ(1)=RX+RA
47000		RA=RA+13.*RSTJ2
47100	C  MOVES OVER FOR NEXT ACCI.
47200		RD=Z
47300		R4=Z
47400		IF(CLEF.NE.-1.)GO TO 7
47500		IF(R4.GT.12.)R4=R4-7.
47600		GO TO 9
47700	7	R4=R4-S
47800		IF(R4.GT.T)R4=R4-7.
47900	C  ABOVE ARRANGES VERT. POS OF ACCIS.
48000	9	J4=R4
48100	C  FOR VERT. POS. IN 'DRWNT' (WHEN PLOTTING.)
48200		CALL CENTX
48300		CALL NOTWRT
48400		Z=RD+W
48500		IF(N)Z=RD+YY
48600	553	N=-N
48700		END